home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
PsL Monthly 1993 December
/
PSL Monthly Shareware CD-ROM (December 1993).iso
/
prgmming
/
dos
/
asm
/
pc370_3.exe
/
lha
/
PRINTDOC.ALC
< prev
next >
Wrap
Text File
|
1988-01-03
|
6KB
|
263 lines
TITLE 'PRINT - PC/370 PRINT UTILITY'
*
* AUTHOR. Don Higgins.
* DATE. 03/29/86. (Copied and modified from DEMOSRC.ALC)
* REMARKS. PC/370 utility program to read selected text file
* and print it with page control.
*
* COPYRIGHT. None. This is a public domain program.
*
* MAINTENANCE.
*
* 05/18/87 CONVERTED TO RELEASE 2 DCB FORMAT
*
* INPUT
*
* 1. A>PRINT drive:file
*
* OUTPUT
*
* 1. File will be printed on the standard printer device with
* page control added via TITLE, EJECT, and SPACE statements as
* defined in standard OS/VS assembler.
*
PRINT CSECT
LR R13,R15
USING PRINT,R13
LA R2,=C'PC/370 PRINT UTILITY R2.0 05/18/87$'
SVC WTO
LA R2,=C' $'
SVC WTO
LA R2,SYSUT1
USING IHADCB,R2
L R1,0(R1) ADDR PARM LENGTH
LA R1,3(R1) SET R1 = FILENAME IN PARM+1
ST R1,DCBDSN SET FILENAME ADDR IN DCB
DROP R2
SVC OPEN
LA R1,ASCTITLE
LA R2,L'ASCTITLE+L'ASCEJECT+L'ASCSPACE
SVC EBCASC
LA R2,=C'ENTER P FOR PRINTER OUTPUT OR ANY KEY FOR CONSOLE$'
SVC WTO
SVC READKEY
STC R0,OPTION
MAINLOOP EQU *
BAL R12,GETREC
LTR R15,R15 TEST FOR END OF FILE
BNZ EOJ
BAL R14,SCAN
LTR R15,R15 TEST FOR COMMAND AND SKIP PRINTING IT
BNZ MAINLOOP
AP LINE,=P'1'
CP LINE,MAXLINE
BNH NEXTLINE
BAL R11,NEWPAGE
NEXTLINE EQU *
LA R0,RECORD
BAL R12,PUTREC
B MAINLOOP
EOJ EQU *
LA R2,SYSUT1
SVC CLOSE
SVC EXIT
TITLE 'SCAN FOR TITLE, EJECT, AND SPACE COMMANDS'
SCAN EQU *
CLI RECORD,ASCBLK
BE SCANOP
CLI RECORD,ASCTAB
BNE SCANEXIT EXIT IF FIRST CHAR. NOT BLANK OR TAB
SCANOP EQU *
LA R4,RECORD+1
SKIPBLK EQU *
CLI 0(R4),ASCLF
BE SCANEXIT
CLI 0(R4),ASCBLK
LA R4,1(R4)
BE SKIPBLK
BCTR R4,0
CLC 0(5,R4),ASCTITLE
BE TITLE
CLC 0(5,R4),ASCEJECT
BE EJECT
CLC 0(5,R4),ASCSPACE
BE SPACE
SCANEXIT EQU *
SR R15,R15
BR R14
TITLE EQU *
LA R4,5(R4)
FINDQ1 EQU *
CLI 0(R4),ASCBLK
BL SCANEXIT IGNORE TITLE IF FIRST QUOTE NOT FOUND
CLI 0(R4),ASCQ
LA R4,1(R4)
BNE FINDQ1
LA R3,TITLEMSG
FINDQ2 EQU *
CLI 0(R4),ASCBLK
BL SETTITLE TRUNCATE IF SECOND QUOTE NOT FOUND
CLI 0(R4),ASCQ
BE SETTITLE
CL R3,=A(TITLEMSG+L'TITLEMSG)
BNL SETTITLE TRUNCATE IF TOO LONG
MVC 0(1,R3),0(R4) COPY TITLE
LA R3,1(R3)
LA R4,1(R4)
B FINDQ2
SETTITLE EQU *
CL R3,=A(TITLEMSG+L'TITLEMSG)
BNL EJECT
MVI 0(R3),ASCBLK PAD WITH BLANKS
LA R3,1(R3)
B SETTITLE
EJECT EQU *
BAL R11,NEWPAGE
LA R15,1
BR R14
SPACE EQU *
LA R0,SPACEMSG
BAL R12,PUTREC
LA R0,SPACEMSG
BAL R12,PUTREC
AP LINE,=P'2'
LA R15,1
BR R14
TITLE 'NEWPAGE - PRINT HEADING'
NEWPAGE EQU *
AP PAGE,=P'1'
ZAP LINE,=P'0'
MVC DPAGE,MASK
ED DPAGE,PAGE
MVC PAGEMSG,PAGEWORK
LA R1,PAGEMSG
LA R2,L'PAGEMSG
SVC EBCASC
LA R0,HEADING
BAL R12,PUTREC
MVI HEADCC,ASCFF FORCE FORM FEED AFTER FIRST PAGE
LA R0,SPACEMSG
BAL R12,PUTREC SKIP SPACE AFTER TITLE
BR R11
TITLE 'GETREC - GET NEXT TEXT RECORD OR SET EOF'
GETREC EQU *
LA R2,SYSUT1
LA R1,RECORD
SVC GET
SR R15,R15
BR R12
EOFRTN EQU *
LA R15,1
BR R12
SYNRTN EQU *
LA R2,=C'IO ERROR$'
SVC WTO
SVC TRACE
DC C'BUG '
TITLE 'PUTREC - PUT RECORD TO STD. PRINT DEVICE'
PUTREC EQU *
LR R4,R0
PUTLOOP EQU *
IC R2,0(R4)
CLI 0(R4),ASCTAB
LA R3,1
BNE PUTCHAR
LA R3,9
LA R2,ASCBLK
PUTCHAR EQU *
SVC CONSOLEC PRINT ON CONSOLE
CLI OPTION,ASCP
BE ISUSVC
CLI OPTION,ASCPL
BE ISUSVC
B PUTSKPP
ISUSVC SVC PRINTC PRINT ON STD. OUTPUT DEVICE ALSO
PUTSKPP EQU *
BCT R3,PUTCHAR
CLI 0(R4),ASCLF
LA R4,1(R4)
BNE PUTLOOP
PUTEXIT EQU *
SR R15,R15
BR R12
TITLE 'DATA SECTION'
LTORG
*
* REGISTER USAGE
*
R0 EQU 0 SVC RETURN CODE
R1 EQU 1 SVC ARGUMENT
R2 EQU 2 SVC ARGUMENT (DCB ADDRESS, DMA, MSG, ETC.)
R3 EQU 3 POINTER FOR MOVING TITLE
R4 EQU 4 OUTPUT BYTE PTR FOR PUTREC
R11 EQU 11 LINK FOR NEWPAGE
R12 EQU 12 LINK FOR GETREC AND PUTREC
R13 EQU 13 BASE
R14 EQU 14 LINK FROM MAINLINE TO ROUTINES
R15 EQU 15 RETURN CODE FROM ROUTINES
*
* PC/370 SVC'S
*
EXIT EQU 0
OPEN EQU 1
CLOSE EQU 2
GET EQU 5
PUT EQU 6
TRACE EQU 9
GMAIN EQU 10
FMAIN EQU 11
ASCEBC EQU 12
EBCASC EQU 13
READKEY EQU 200+1 MS-DOS SVC 1 READ KEY
CONSOLEC EQU 200+2 MS-DOS SVC 2 DISPLAY CHAR IN R2 ON CONSOLE
PRINTC EQU 200+5 MS-DOS SVC 5 PRINT CHAR IN R2 ON STD. PRINTER
WTO EQU 200+9 MS-DOS SVC 9 PRINT STRING WITH ENDING $ ON CON.
*
* DATA AREAS
*
TBUFF EQU X'80' BUFFER FOR DIRECTORY SEARCH
RECORD DS XL256 LOGICAL RECORD AREA
ASCLF EQU X'0A' ASCII LINE FEED
ASCCR EQU X'0D' ASCII CARRIAGE RETURN
ASCASK EQU X'2A' ASCII ASTERISK FOR ALC COMMENT CHECK
ASCBLK EQU X'20' ASCII SPACE
ASCQ EQU X'27' ASCII QUOTE
ASCTAB EQU X'09' ASCII TAB
ASCFF EQU X'0C' ASCII FORM FEED
ASCP EQU X'50' UPPERCASE ASCII P
ASCPL EQU X'70' LOWER CASE ASCII P
OPTION DC X'00'
ASCTITLE DC C'TITLE'
ASCEJECT DC C'EJECT'
ASCSPACE DC C'SPACE'
PAGE DC PL2'0'
LINE DC PL2'50'
MAXLINE DC PL2'50'
MASK DC X'40202020' EDIT MASK FOR PL2
HEADING EQU *
HEADCC DC AL1(ASCBLK)
TITLEMSG DC 0CL65' ',65AL1(ASCBLK),2AL1(ASCBLK)
PAGEMSG DC 0CL8' ',9AL1(ASCBLK)
SPACEMSG DC AL1(ASCCR,ASCLF) END OF HEADING
WORK DC 0CL20' '
PAGEWORK DC 0CL8' ',C'PAGE'
DPAGE DC CL4' ZZZ'
COPY CPY/IHADCB
*
* END OF DSECT
*
PRINT CSECT
SYSUT1 DC 0F'0',C'ADCB'
DC A(TBUFF+7) PATH/FILE NAME IN OS/VS PARM
DC X'FFFF'
DC X'00'
DC C'SGT' SEQ. GET TEXT
DC X'0A1A'
DC H'255' LRECL
DC H'8192' BLKSZ
DC A(EOFRTN) EODAD
DC A(SYNRTN) SYNAD
DC A(RECORD) RECORD AREA
DC XL(SYSUT1+LDCB-*)'00'
END PRINT